home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s5.arc / REWRITED.MOD < prev    next >
Text File  |  1987-03-05  |  3KB  |  88 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        Rewrite_Dialing_Directory --- Rewrite dialing directory       *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Rewrite_Dialing_Directory;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Rewrite_Dialing_Directory                            *)
  10. (*                                                                      *)
  11. (*     Purpose:    Rewrites the dialing directory                       *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Rewrite_Dialing_Directory;                                    *)
  16. (*                                                                      *)
  17. (*     Remarks:                                                         *)
  18. (*                                                                      *)
  19. (*        Watch out -- some tricky stuff with string data and lengths   *)
  20. (*        is used here.                                                 *)
  21. (*                                                                      *)
  22. (*----------------------------------------------------------------------*)
  23.  
  24. VAR
  25.    I         : INTEGER;
  26.    F         : TEXT[2048];
  27.    Phone_Str : AnyStr;
  28.    Phone_Name: AnyStr;
  29.    Full_Name : AnyStr;
  30.  
  31. BEGIN (* Rewrite_Dialing_Directory *)
  32.  
  33.    TextMode( Text_Mode );
  34.  
  35.    IF ( POS( '\' , Dialing_File_Name ) = 0 ) AND
  36.       ( POS( ':' , Dialing_File_Name ) = 0 ) THEN
  37.       Full_Name := Home_Dir + Dialing_File_Name
  38.    ELSE
  39.       Full_Name := Dialing_File_Name;
  40.  
  41.    WRITELN;
  42.    ClrEol;
  43.  
  44.    WRITE('Rewriting updated phone directory to ',Dialing_File_Name);
  45.    ClrEol;
  46.    WRITELN;
  47.  
  48.       (*$I-*)
  49.    ASSIGN ( F , Full_Name );
  50.    REWRITE( F );
  51.       (*$I+*)
  52.  
  53.    IF ( INT24Result = 0 ) THEN
  54.       BEGIN
  55.  
  56.          Phone_Str[0] := CHR( Dialing_Dir_Entry_Length );
  57.  
  58.          FOR I := 1 TO Dialing_Dir_Size DO
  59.             BEGIN
  60.                MOVE( Dialing_Directory^[I], Phone_Str[1],
  61.                      Dialing_Dir_Entry_Length  );
  62.                WRITELN( F, Phone_Str );
  63.             END;
  64.  
  65.          CLOSE( F );
  66.  
  67.          WRITELN;
  68.          ClrEol;
  69.  
  70.          WRITE('Phone directory ',Dialing_File_Name,' updated.');
  71.          ClrEol;
  72.          WRITELN;
  73.  
  74.       END
  75.    ELSE
  76.       BEGIN
  77.          WRITELN;
  78.          ClrEol;
  79.          WRITE('Can''t update phone directory ',Full_Name);
  80.          ClrEol;
  81.       END;
  82.  
  83.       (*$I+*)
  84.  
  85.    DELAY( Two_Second_Delay );
  86.  
  87. END   (* Rewrite_Dialing_Directory *);
  88.